home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol037 / ldirc.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  4.3 KB  |  115 lines
  1. 10 REM for compilation only - not to be interpreted
  2. 20 'Display File Allocation Table and Directory
  3. 30 CLS :CLEAR ' by J.L. Aker - San Jose CA
  4. 40 DEFINT B,D,F,I,T,S,K,N,R :DEF SEG
  5. 50  C$=STRING$(28,"1") 'dummy string for code
  6. 60  BFR$=STRING$(512,"1")  'buffer for data
  7. 70 DIM SS(318),NA$(112) : CR$=CHR$(13)
  8. 80 INPUT"Drive, A or B";SG$
  9. 90 IF SG$="b" OR SG$="B" THEN DRV=1
  10. 100 INPUT"Screen or Printer, S or P";SG$
  11. 110 IF SG$="p" OR SG$="P" THEN DEV$="LPT1:" ELSE DEV$="SCRN:" : GOTO 140
  12. 120 INPUT"Condensed print, Y or N";SG$
  13. 130 IF SG$="n" OR SG$="N" THEN SG$="2"+CHR$(18) ELSE SG$="0"+CHR$(15)
  14. 140 INPUT"Skip Deleted Directory slots, Y or N";DS$
  15. 150 OPEN DEV$ FOR OUTPUT AS 1
  16. 160 IF DEV$="LPT1:" THEN LPRINT CHR$(27);SG$;
  17. 170 DATA 16,BA,00,00,B9,04,00,B8
  18. 180 DATA 79,0E,8B,D8,B8,01,02,CD
  19. 190 DATA 13,B7,00,8A,DC,9A,07,00
  20. 200 DATA 00,F6,17,CB
  21. 210 OFS=VARPTR(C$) 'string descriptor
  22. 220 OFC=PEEK(OFS+3)*256+PEEK(OFS+2) 'address of code
  23. 230 DEF USR0=OFC 'point to code and move in code bytes
  24. 240 FOR I = 0 TO LEN(C$)-1
  25. 250  READ S$
  26. 260  POKE OFC+I,VAL("&h"+S$)
  27. 270 NEXT I
  28. 280 OT=OFC+6 : OS=OFC+5 : OH=OFC+3
  29. 290 SPTR=VARPTR(BFR$)
  30. 300 SOFS=PEEK(SPTR+3)*256+PEEK(SPTR+2)
  31. 310 POKE OFC+8,SOFS AND &HFF : POKE OFC+9,SOFS\256
  32. 320 'get fat sector
  33. 330 POKE OT,0 :POKE OS,2 :POKE OFC+2,DRV
  34. 340 GOSUB 1110 ' read sector
  35. 350 N=0 'Get the data bytes in array SS; SS(0)=4095 => 320kb format
  36. 360 FOR I = 0 TO 474 STEP 3
  37. 370  B1=PEEK(I+SOFS)
  38. 380  B2=PEEK(I+1+SOFS)
  39. 390  B3=PEEK(I+2+SOFS)
  40. 400  SS(N)=B1+(B2 AND &HF)*256
  41. 410  SS(N+1)=(B2 AND &HF0)\16+B3*16
  42. 420  N=N+2
  43. 430 NEXT I
  44. 440 IF SS(0)=4095 THEN DSD=-1 ELSE DSD=0
  45. 450 PRINT #1, "File Allocation Table:";CR$;"   ";
  46. 460 FOR I=0 TO 15 :PRINT #1, USING"\  \";" --"+HEX$(I); :NEXT I
  47. 470 PRINT #1, SPC(3);"Tracks"
  48. 480 PRINT #1, "00- "; :T=0
  49. 490 FOR I=0 TO 314-DSD*2 STEP 16
  50. 500  FOR K=0 TO 15
  51. 510 IF SS(I+K)=0 THEN FSEC=FSEC+1
  52. 520   PRINT #1, USING "\  \";RIGHT$("00"+HEX$(SS(I+K)),3);
  53. 530   IF I+K=314-DSD*2 THEN 570
  54. 540  NEXT K
  55. 550  PRINT #1, USING "###";T;T+1;T+2
  56. 560  PRINT #1, RIGHT$("0"+HEX$((I+16)\16),2)"- "; :T=T+2
  57. 570 NEXT I
  58. 580 PRINT #1, SPC(20+DSD*8);
  59. 590 PRINT #1, USING "###";T;T+1  :PRINT #1," ";SPC(1-DSD);
  60. 600 IF DSD THEN 630
  61. 610 FOR I=5 TO 20 : PRINT#1,RIGHT$("  "+STR$((I MOD 8)+1),4); :NEXT I
  62. 620 PRINT #1," << Sectors" :GOTO 700
  63. 630 FOR H=.9 TO 4 STEP .2
  64. 640 FOR S=7 TO 14 STEP 2
  65. 650 PRINT#1,STR$(INT(H) MOD 2);":";RIGHT$(STR$(S MOD 8),1);
  66. 660 H=H+.2
  67. 670 NEXT S,H
  68. 680 PRINT#1," << Hd:Sec"
  69. 690 PRINT#1,"  ";
  70. 700 ' Get the Directory
  71. 710 HD$="Name     Ext MM/DD/YY HH:MM S/C Length"
  72. 720 FOR S=3 TO 6-3*DSD
  73. 730 IF S>7 THEN POKE OH,1
  74. 740  POKE OS,(S MOD 8)+1
  75. 750  GOSUB 1110 ' read sector
  76. 760  FOR I=0 TO 15
  77. 770   N$=""
  78. 780   FOR X=0 TO 31
  79. 790    N$=N$+CHR$(PEEK(I*32+X+SOFS))
  80. 800   NEXT X
  81. 810   NA$((S-3)*16+I)=N$
  82. 820  NEXT I
  83. 830 NEXT S
  84. 840 CNT#=512#*(1-DSD)*FSEC
  85. 850 PRINT #1, FSEC;"Free S/C,";CNT#;"Bytes free"
  86. 860 PRINT #1,"Directory:";CR$;HD$;"  ";HD$
  87. 870 FOR I=0 TO 63-DSD*48
  88. 880 IF LEFT$(NA$(I),1)<>CHR$(&HE5) THEN 910
  89. 890 IF MID$(NA$(I),2,1)=CHR$(&HF6) THEN I=64-DSD*48 : GOTO 1040
  90. 900 IF DS$="n" OR DS$="N" THEN MID$(NA$(I),1,1)="*" ELSE 1050
  91. 910 PRINT #1, LEFT$(NA$(I),8);" ";MID$(NA$(I),9,3);
  92. 920 B1=ASC(MID$(NA$(I),25,1)) : B2=ASC(MID$(NA$(I),26,1))
  93. 930 B3=ASC(MID$(NA$(I),28,1)) : B4=ASC(MID$(NA$(I),27,1))
  94. 940 B5!=ASC(MID$(NA$(I),32,1)) : B6!=ASC(MID$(NA$(I),31,1))
  95. 950 B7!=ASC(MID$(NA$(I),30,1)) : B8!=ASC(MID$(NA$(I),29,1))
  96. 960 B9=ASC(MID$(NA$(I),23,1)) : BA=ASC(MID$(NA$(I),24,1))
  97. 970 PRINT #1," ";RIGHT$(STR$(100+(B1 AND &HE0)\32+(B2 AND 1)*8),2);
  98. 980 PRINT #1,"-";RIGHT$(STR$(100+(B1 AND &H1F)),2);
  99. 990 PRINT #1,"-";RIGHT$(STR$((B2 AND &HFE)\2+80),2);
  100. 1000 PRINT #1," ";RIGHT$(STR$(100+BA\8),2);
  101. 1010 PRINT #1,":";RIGHT$(STR$(100+B9\32+(BA AND &H7)*8),2);
  102. 1020 PRINT #1, USING "\  \";" "+RIGHT$("00"+HEX$(B3*256+B4),3);
  103. 1030 PRINT #1, USING "#######";(B5!*256+B6!)*65536!+B7!*256+B8!;
  104. 1040 IF POS(0)>72 THEN PRINT #1,  ELSE PRINT #1, "  ";
  105. 1050 NEXT I
  106. 1060 IF DEV$="LPT1:" THEN LPRINT CR$;DATE$,TIME$;CHR$(27)"2";CHR$(18);CHR$(12)
  107. 1070 CLOSE #1 : LOCATE 25,1
  108. 1080 INPUT "Run again, Y or N";Q$
  109. 1090 IF Q$="y" OR Q$="Y" THEN GOTO 30
  110. 1100 cls:END
  111. 1110 RET=USR0(0)
  112. 1120 IF RET<>0 THEN RET=USR0(0) 'do a retry on error
  113. 1130 IF RET<>0 THEN PRINT"Disk error status: ";RIGHT$("0"+HEX$(RET),2) :END
  114. 1140 RETURN
  115.